home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / fpkpas92.zip / SRCRTL.ZIP / RTL / DOS / GRAPH.PP < prev    next >
Text File  |  1997-07-01  |  22KB  |  818 lines
  1. unit GRAPH;
  2. {$DEFINE DEBUG}
  3. { ****************************************************************************
  4.  
  5.                          FPKPascal Runtime-Library
  6.                           Copyright (c) 1994,96 by
  7.                       Florian Klämpfl & Gernot Tenchio
  8.  
  9.   ****************************************************************************
  10.  
  11. Version 0.1.1
  12.  
  13. Diese Version der Grafikunit laeuft in allen von mir getesten Umgebungen. Soll
  14. heisen: DPMI  mit QEMM, im  DOS-Fenster von WIN95, XMS, VCPI mit HIMEMS/EMM386
  15. und was  weiss ich. Des weiteren getestet mit ARK2000PV, CL5440GD, Spea Mirage 
  16. V7, ATI Mach 64 ...
  17. Zur Zeit wird nur VESA-Standart 1.2 unterstuetzt.
  18.  
  19. Wichtige Hinweise: 
  20.  
  21.  .  Die Detectfunction liefert die hoechstmoegliche von der Grafikkarte unter-
  22.     stuetzte Aufloesung zurueck . Das kann bei 2MB Speicher durchaus 1600x1200
  23.     bedeuten. Die  meisten  herkoemmlichen  14/15 Zoll Monitore  sind   dieser 
  24.     Aufloesung nicht maechtig  und koennen unter Umstaenden durch eine zu hohe 
  25.     Aufloesung beschaedigt oder gar zerstoert werden. Deshalb im Zweifelsfalle 
  26.     erst einmal eine feste Aufloesung von zB. 800x600 vorgeben.
  27.  
  28.  .  In manchen Faellen koennen  Speicherverwalter  ala QEMM die  Erkennung des 
  29.     VESA-BIOS behindern. Bisher nur  bei QEMM mit eingeschalteter Stealthfunc-
  30.     tion bemerkt. In diesem Falle hilft nur ausschalten selbiger Funktion.
  31.  
  32.  .  Ich  weiss nicht  warum bei  Borland  Outtext mit dem Defaultfont garnicht
  33.     angezeigt wird, wenn es nicht auf den Bildschirm passt. Hier ist es jeden-
  34.     falls nicht so !! 
  35.  
  36.  .  Ich habe noch keine anstaendige Bankswitchroutine zustande bekommen :-(
  37.     Verwendung von UNIVBE 5.1 bringt irre Performance .
  38.  
  39. Systemanforderungen: VESA kompatible Grafikkarte mit mindestens 512K Speicher
  40.                      bzw. VGA-Karte mit entsprechendem Treiber und ein PaeCae
  41.                 
  42.   ****************************************************************************
  43.  
  44. History :
  45.  
  46. Anf.-Mitte Okt. 96  : grundlegende VESA-Routinen
  47.  
  48. Mitte Okt. 96       : Putpixel / Getpixel laufen mit 256 Farben,
  49.                       schnoeden Bresenham & entsprechende Routinen 
  50.                       ( lineto etc. ) implementiert
  51.                   
  52. 20.10.96            : DrawfilledEllipse & Circle funktionieren
  53.  
  54. 12.11.96            : Textausgabe mit BGI-Fonts funktioniert
  55.  
  56. 14.11.96            : aus Faulheit Defaultfont 'direkt eingebaut' 
  57.                       ( FONT.PPI )
  58.  
  59. 18.11.96            : Fillpattern ,Bar 
  60.                       
  61. 23.11.96            : Bar3D, Rectangle, Cleardevice/viewport etc.
  62.  
  63. 26.11.96            : 15/16Bit-Modis implementiert
  64.  
  65. 28.11.96            : funktionierendes, aber leider inkompatibles 
  66.                       Floodfill eingebaut
  67.     
  68. 30.11.96            : Probleme mit GetX/GetY nach Textausgabe behoben
  69.  
  70. 02.12.96            : Farbzuweisungen fuer diverse Operationen angepasst  
  71.                       Get/Setaspectratio implementiert
  72.   
  73. 20.12.96            : Filltriangle implementiert
  74.  
  75.   **************************************************************************** }
  76.  
  77. interface
  78.  
  79. uses go32;
  80.  
  81. {$I GLOBAL.PPI}
  82. {$I STDCOLOR.PPI}
  83.  
  84. procedure CloseGraph ;
  85. function  GraphResult : Integer;
  86. procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
  87. procedure RestoreCRTMode ;
  88. procedure SetGraphBufSize(BufSize : longint);
  89. function  RegisterBGIdriver(driver : pointer) : integer;
  90. function  InstallUserDriver(const DriverFileName : string;AutoDetectPtr : pointer) : integer;
  91. function  GetDriverName: String;
  92. function  GetModeName(Mode:Integer):String;
  93. function  GetGraphMode:Integer;
  94. procedure GetAspectRatio(var _Xasp,_Yasp : word);
  95. procedure SetAspectRatio(_Xasp,_Yasp : word);
  96.  
  97. function  GetMaxMode : Integer;
  98. function  GetMaxX : Integer;
  99. function  GetMaxY : Integer;
  100. function  GetX : Integer;
  101. function  GetY : Integer;
  102. procedure Bar(x1,y1,x2,y2 : Integer);
  103. procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
  104. procedure GetViewSettings(var viewport : ViewPortType);
  105. procedure SetActivePage(page : word);
  106. procedure SetVisualPage(page : word);
  107. procedure SetWriteMode(WriteMode : integer);
  108. procedure SetViewPort(x1,y1,x2,y2 : integer;clip : boolean);
  109. procedure Cleardevice;
  110. procedure ClearViewport;
  111. procedure Rectangle(x1,y1,x2,y2 : integer);
  112.  
  113. { PIXEL.PPI }
  114. function  GetPixel(x,y : integer):longint;
  115. procedure PutPixel(x,y : integer; Colour: longint);
  116.  
  117. { LINE.PPI }
  118. procedure Line(x1,y1,x2,y2 : integer);
  119. procedure LineTo(x,y : integer);
  120. procedure LineRel(dx,dy : integer);
  121. procedure MoveTo(x,y : integer);
  122. procedure MoveRel(dx,dy : integer);
  123. procedure GetLineSettings(var LineInfo : LineSettingsType);
  124. procedure SetLineStyle(LineStyle : word;pattern : word;thickness : word);
  125.  
  126. { PALETTE.PPI }
  127. procedure GetRGBPalette(ColorNum:byte; var RedValue,GreenValue,BlueValue:byte);
  128. procedure SetRGBPalette(ColorNum,RedValue,GreenValue,BlueValue:byte);
  129. procedure SetAllPalette(var Palette : PaletteType);
  130. procedure GetPalette(var Palette : PaletteType);
  131.  
  132. { ELLIPSE.PPI }
  133. procedure FillEllipse(x,y:Integer;XRadius,YRadius:Word);
  134. procedure Circle(x,y:Integer;Radius:Word);
  135.  
  136. { ARC.PPI }
  137. procedure Arc(x,y,alpha,beta:Integer;Radius:Word);
  138.  
  139. { COLORS.PPI }
  140. function  GetBkColor : longint;
  141. function  GetColor : longint;
  142. function  GetMaxColor : longint;
  143. procedure SetColor(Color : longint);
  144. procedure SetBkColor(Color : longint);
  145.  
  146. { FILL.PPI }
  147. procedure FloodFill(x,y:integer; Border:longint);
  148. procedure GetFillSettings(var FillInfo : FillSettingsType);
  149. procedure GetFillPattern(var FillPattern : FillPatternType); 
  150. procedure SetFillStyle(pattern : word;color : longint);
  151. procedure SetFillPattern(pattern : FillPatternType;color : longint);
  152.  
  153. { IMAGE.PPI }
  154. function  ImageSize(x1,y1,x2,y2 : integer) : word;
  155. procedure GetImage(x1,y1,x2,y2 : integer;var BitMap);
  156. procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
  157.  
  158. { TEXT.PPI }
  159. procedure GetTextSettings(var TextInfo : TextSettingsType);
  160. procedure OutText(const TextString : string);
  161. procedure OutTextXY(x,y : integer;const TextString : string);
  162. procedure OutText(const Charakter : char);
  163. procedure OutTextXY(x,y : integer;const Charakter : char);
  164. procedure SetTextJustify(horiz,vert : word);
  165. procedure SetTextStyle(Font, Direction : word; CharSize : word);
  166. procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
  167. function  TextHeight(const TextString : string) : word;
  168. function  TextWidth(const TextString : string) : word;
  169. function  RegisterBGIfont(font : pointer) : integer;
  170. function  InstallUserFont(const FontFileName : string) : integer;
  171.  
  172. { extendet non Borland-compatible }
  173.  
  174. { TRIANGLE.PPI }
  175. procedure FillTriangle(A,B,C:Pointtype);
  176.  
  177. procedure WaitRetrace;
  178. function  Convert(color:longint):longint;
  179.  
  180. implementation
  181.  
  182. type
  183.   PString=^String;
  184.   PInteger=^integer;
  185.   PWord=^word;
  186.   PLong=^longint;
  187.   
  188.   VgaInfoBlock = record
  189.     VESASignature: array[1..4]of Char;
  190.     VESAloVersion: Byte;
  191.     VESAhiVersion: Byte;
  192.     OEMStringPtr : longint;
  193.     Capabilities : longint;
  194.     VideoModePtr : longint;
  195.     TotalMem     : word;
  196.   { VESA 2.0 }
  197.     OEMversion   : word;
  198.     VendorPtr    : longint;
  199.     ProductPtr   : longint;
  200.     RevisionPtr  : longint;
  201.     filler       : Array[1..478]of Byte;
  202.   end;
  203.  
  204.   VesaInfoBlock=record
  205.     ModeAttributes : word;
  206.     WinAAttributes : byte;
  207.     WinBAttributes : byte;
  208.     WinGranularity : word;
  209.     WinSize        : word;
  210.     segWINA        : word;
  211.     segWINB        : word;
  212.     RealWinFuncPtr : longint;
  213.     BPL            : word;
  214.   { VESA 1.2 }
  215.     XResolution    : word;
  216.     YResolution    : word;
  217.     XCharSize      : byte;
  218.     YCharSize      : byte;
  219.     MumberOfPlanes : byte;
  220.     BitsPerPixel   : byte;
  221.     NumberOfBanks  : byte;
  222.     MemoryModel    : byte;
  223.     BankSize       : byte;
  224.     NumberOfPages  : byte;
  225.     reserved       : byte;
  226.     rm_size        : byte;
  227.     rf_pos         : byte;
  228.     gm_size        : byte;
  229.     gf_pos         : byte;
  230.     bm_size        : byte;
  231.     bf_pos         : byte;
  232.     res_mask       : word;
  233.     DirectColorInfo: byte;
  234.   { VESA 2.0 }
  235.     PhysAddress    : longint;
  236.     OffscreenPtr   : longint;
  237.     OffscreenMem   : word;
  238.     reserved2      : Array[1..458]of Byte;
  239.    end;
  240.     
  241. {$I MODES.PPI}
  242.  
  243. const
  244.      CheckRange    : Boolean=true;
  245.      isVESA2       : Boolean=false;
  246.      core          : longint=$E0000000;
  247.      
  248. var    { X/Y Verhaeltnis des Bildschirm }               
  249.        AspectRatio  : real;
  250.        XAsp , YAsp  : Word;
  251.        { Zeilen & Spalten des aktuellen Graphikmoduses }
  252.        _maxx,_maxy : longint; 
  253.        { aktuell eingestellte Farbe }
  254.        aktcolor : longint;
  255.        { Hintegrundfarbe }
  256.        aktbackcolor : longint;
  257.        { Videospeicherbereiche }
  258.        wbuffer,rbuffer,wrbuffer : ^byte;
  259.        { aktueller Ausgabebereich }
  260.        aktviewport : ViewPortType;
  261.        aktscreen   : ViewPortType;
  262.        { der Graphikmodus, der beim Start gesetzt war }
  263.        startmode : byte;
  264.        { Position des Graphikcursors }
  265.        curx,cury : longint;
  266.        { true, wenn die Routinen des Graphikpaketes verwendet werden dürfen }
  267.        isgraphmode : boolean;
  268.        { Einstellung zum Linien zeichnen }
  269.        aktlineinfo : LineSettingsType;
  270.        { Fehlercode, wird von graphresult zurückgegeben }
  271.        _graphresult : integer;
  272.        { aktuell eingestellte Füllart }
  273.        aktfillsettings : FillSettingsType;
  274.        { aktuelles Füllmuster }
  275.        aktfillpattern : FillPatternType;
  276.        { Schreibmodus }
  277.        aktwritemode : word;
  278.        { Schrifteinstellung }
  279.        akttextinfo : TextSettingsType;
  280.        { momentan gesetzte Textskalierungswerte }
  281.        aktmultx,aktdivx,aktmulty,aktdivy : word;
  282.        { Pfad zu den Fonts }
  283.        bgipath : string;
  284.        { Pointer auf Hilfsspeicher }
  285.        buffermem : pointer;
  286.        { momentane Größe des Buffer }
  287.        buffersize : longint;
  288.        { in diesem Puffer werden bei SetFillStyle bereits die Pattern in der }
  289.        { zu verwendenden Farbe abgelegt }
  290.        PatternBuffer : Array[0..63]of LongInt;
  291.        
  292.        X_Array         : array[0..1280]of LongInt;
  293.        Y_Array         : array[0..1024]of LongInt;
  294.  
  295.        Sel,Seg      : word;    
  296.        VGAInfo      : VGAInfoBlock;
  297.        VESAInfo     : VESAInfoBlock;
  298.    { Selectors for Protected Mode }
  299.        seg_WRITE    : word;    
  300.        seg_READ     : word;   
  301.    { Registers for RealModeInterrupts in DPMI-Mode }
  302.        dregs        : TRealRegs;
  303.        AW_Bank      : longint;
  304.        AR_Bank      : Longint;
  305.    { Variables for Bankswitching }
  306.        BytesPerLine : longint;
  307.        BytesPerPixel: Word;
  308.        WinSize      : longint;   { Expample $0x00010000 . $0x00008000 }
  309.        WinLoMask    : longint;   {          $0x0000FFFF   $0x00007FFF }
  310.        WinShift     : byte;
  311.        GranShift    : byte;
  312.        Granular     : longint;
  313.        Granularity  : longint;
  314.        graphgetmemptr,
  315.        graphfreememptr,
  316.        bankswitchptr :pointer;
  317.        isDPMI        :Boolean;
  318.        SwitchCS,SwitchIP : word;
  319.  
  320. procedure Oh_Kacke(ErrString:String);
  321. begin
  322.   CloseGraph; 
  323.   writeln('Error in Unit VESA: ',ErrString);
  324.   halt;
  325. end;
  326.  
  327. {$I MOVE.PPI}
  328. {$I IBM.PPI}
  329.  
  330. procedure WaitRetrace;
  331. begin
  332.   asm
  333.     cli
  334.     movw  $0x03Da,%dx 
  335. WaitNotHSyncLoop:
  336.     inb   %dx,%al
  337.     testb $0x8,%al
  338.     jnz   WaitNotHSyncLoop
  339. WaitHSyncLoop:
  340.     inb   %dx,%al
  341.     testb $0x8,%al
  342.     jz    WaitHSyncLoop
  343.     sti
  344.   end;
  345. end;
  346.     
  347. procedure getmem(var p : pointer;size : longint);
  348. begin
  349.   asm
  350.     pushl 12(%ebp)
  351.     pushl 8(%ebp)
  352.     movl _GRAPHGETMEMPTR,%eax
  353.     call %eax
  354.   end;
  355. end;
  356.  
  357. procedure freemem(var p : pointer;size : longint);
  358. begin
  359.   asm
  360.     pushl 12(%ebp)
  361.     pushl 8(%ebp)
  362.     movl _GRAPHFREEMEMPTR,%eax
  363.     call %eax
  364.   end;
  365. end;
  366.  
  367. procedure graphdefaults;
  368.       begin
  369.          _graphresult:=grOk;
  370.          if not isgraphmode then
  371.            begin
  372.               _graphresult:=grnoinitgraph;
  373.               exit;
  374.            end;
  375.          { Linientyp }
  376.          aktlineinfo.linestyle:=solidln;
  377.          aktlineinfo.thickness:=normwidth;
  378.  
  379.          { Füllmuster }
  380.          aktfillsettings.color:=white;
  381.          aktfillsettings.pattern:=solidfill;
  382.  
  383.          { Zeichenfarbe }
  384.          aktcolor:=(white shl 24)+(white shl 16)+(white shl 8)+white;
  385.          aktbackcolor:=black;
  386.  
  387.          { Viewport setzen }
  388.          aktviewport.clip:=true;
  389.          aktviewport.x1:=0;
  390.          aktviewport.y1:=0;
  391.          aktviewport.x2:=_maxx-1;
  392.          aktviewport.y2:=_maxy-1;
  393.  
  394.          aktscreen:=aktviewport;
  395.          
  396.          { normaler Schreibmodus }
  397.          setwritemode(normalput);
  398.  
  399.          { Schriftart einstellen }
  400.          akttextinfo.font:=DefaultFont;
  401.          akttextinfo.direction:=HorizDir;
  402.          akttextinfo.charsize:=1;
  403.          akttextinfo.horiz:=LeftText;
  404.          akttextinfo.vert:=TopText;
  405.          
  406.          { Vergrößerungsfaktoren}
  407.          XAsp:=10000; YAsp:=10000;
  408.          aspectratio:=1;
  409.       end;
  410.  
  411. { ############################################################### }
  412. { #################  Ende der internen Routinen  ################ }
  413. { ############################################################### }
  414.  
  415. {$I COLORS.PPI}
  416. {$I PALETTE.PPI}
  417. {$I PIXEL.PPI}
  418. {$I LINE.PPI}
  419. {$I ELLIPSE.PPI}
  420. {$I TRIANGLE.PPI}
  421. {$I ARC.PPI}
  422. {$I IMAGE.PPI}
  423. {$I TEXT.PPI}
  424. {$I FILL.PPI}
  425.  
  426. function GetDrivername:String;
  427. begin
  428.   if not isgraphmode then
  429.     begin
  430.       _graphresult:=grNoInitGraph;
  431.       Exit;
  432.     end;
  433.   GetDriverName:=('internal VESA-Driver');
  434. end;
  435.  
  436. function GetModeName(Mode:Integer):String;
  437. var s1,s2,s3:string;
  438. begin
  439.   if not isgraphmode then
  440.     begin
  441.       _graphresult:=grNoInitGraph;
  442.       Exit;
  443.     end;
  444.   str(_maxx,s1);
  445.   str(_maxy,s2);
  446.   str(getmaxcolor+1,s3);
  447.   GetModeName:=('VESA '+s1+'x'+s2+'x'+s3);
  448. end;
  449.  
  450. function GetGraphMode:Integer;
  451. begin
  452.   if not isgraphmode then
  453.     begin
  454.       _graphresult:=grNoInitGraph;
  455.       Exit;
  456.     end;
  457.   GetGraphMode:=GetVesaMode;
  458. end;
  459.   
  460. procedure ClearViewport;
  461. var bank1,bank2,diff,c:longint;
  462.     ofs1,ofs2         :longint;
  463.     y : integer;
  464. begin
  465.   if not isgraphmode then
  466.     begin
  467.       _graphresult:=grNoInitGraph;
  468.       Exit;
  469.     end;
  470.   c:=aktcolor;
  471.   aktcolor:=aktbackcolor;
  472.   ofs1:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x1] ;
  473.   ofs2:=Y_ARRAY[aktviewport.y1] + X_ARRAY[aktviewport.x2] ;
  474.   for y:=aktviewport.y1 to aktviewport.y2 do
  475.   begin
  476.     bank1:=ofs1 shr winshift;
  477.     bank2:=ofs2 shr winshift;
  478.     if bank1 <> AW_BANK then 
  479.     begin 
  480.       Switchbank(bank1); 
  481.       AW_BANK:=bank1;
  482.     end;
  483.     if bank1 <> bank2 then 
  484.     begin
  485.       diff:=((bank2 shl winshift)-ofs1) div BytesPerPixel;
  486.       horizontalline(aktviewport.x1, aktviewport.x1+diff-1, y);
  487.       Switchbank(bank2); AW_BANK:=bank2;
  488.       horizontalline(aktviewport.x1+diff, aktviewport.x2, y); 
  489.     end else horizontalline(aktviewport.x1, aktviewport.x2, y);
  490.     ofs1:=ofs1 + BytesPerLine;
  491.     ofs2:=ofs2 + BytesPerLine;
  492.   end;
  493.   aktcolor:=c;
  494. end;
  495.  
  496. procedure GetAspectRatio(var _Xasp,_Yasp : word);
  497. begin
  498.   _graphresult:=grOk;
  499.   if not isgraphmode then
  500.     begin
  501.       _graphresult:=grnoinitgraph;;
  502.       exit;
  503.     end;
  504.     _XAsp:=XAsp; _YAsp:=YAsp;
  505. end;
  506.     
  507. procedure SetAspectRatio(_Xasp, _Yasp : word);
  508. begin     
  509.   _graphresult:=grOk;
  510.     if not isgraphmode then
  511.       begin
  512.         _graphresult:=grnoinitgraph;
  513.         exit;
  514.       end;
  515.     Xasp:=_XAsp; YAsp:=_YAsp;
  516. end; 
  517.     
  518.  
  519. procedure ClearDevice;
  520. var Viewport:ViewportType;
  521. begin
  522.   if not isgraphmode then
  523.     begin
  524.       _graphresult:=grNoInitGraph;
  525.       Exit;
  526.     end;
  527.   Viewport:=aktviewport;
  528.   SetViewport(0,0,_maxx-1,_maxy-1,Clipon);
  529.   ClearViewport;
  530.   aktviewport:=viewport;
  531. end;
  532.  
  533. procedure Rectangle(x1,y1,x2,y2:integer);
  534. begin
  535.   if not isgraphmode then
  536.     begin
  537.       _graphresult:=grNoInitGraph;
  538.       Exit;
  539.     end;
  540.   Line(x1,y1,x2,y1);
  541.   Line(x1,y1,x1,y2);
  542.   Line(x2,y1,x2,y2);
  543.   Line(x1,y2,x2,y2);
  544. end;
  545.  
  546. procedure Bar(x1,y1,x2,y2:integer);
  547. var y               : Integer;
  548.     origcolor       : longint;
  549.     origlinesettings: Linesettingstype;
  550. begin
  551.   if not isgraphmode then
  552.     begin
  553.       _graphresult:=grNoInitGraph;
  554.       Exit;
  555.     end;
  556.   origlinesettings:=aktlineinfo;
  557.   origcolor:=aktcolor;
  558.   aktlineinfo.linestyle:=solidln;
  559.   aktlineinfo.thickness:=normwidth;
  560.   case aktfillsettings.pattern of 
  561.      0 : begin 
  562.            aktcolor:=aktbackcolor;
  563.            for y:=y1 to y2 do line(x1,y,x2,y);
  564.          end;
  565.      1 : begin 
  566.            aktcolor:=aktfillsettings.color;
  567.            for y:=y1 to y2 do line(x1,y,x2,y);
  568.          end;
  569.      else for y:=y1 to y2 do patternline(x1,x2,y);
  570.   end;
  571.   aktcolor:=origcolor;
  572.   aktlineinfo:=origlinesettings;
  573. end;  
  574.  
  575. procedure bar3D(x1, y1, x2, y2 : integer;depth : word;top : boolean);
  576. begin
  577.   if not isgraphmode then
  578.     begin
  579.       _graphresult:=grNoInitGraph;
  580.       Exit;
  581.     end;
  582.   Bar(x1,y1,x2,y2);
  583.   Rectangle(x1,y1,x2,y2);
  584.   if top then begin
  585.     Moveto(x1,y1);
  586.     Lineto(x1+depth,y1-depth);
  587.     Lineto(x2+depth,y1-depth);
  588.     Lineto(x2,y1);
  589.   end;
  590.   Moveto(x2+depth,y1-depth);
  591.   Lineto(x2+depth,y2-depth);
  592.   Lineto(x2,y2);
  593. end;
  594.  
  595. procedure SetGraphBufSize(BufSize : longint);
  596. begin
  597.   if assigned(buffermem) then
  598.   freemem(buffermem,buffersize);
  599.   getmem(buffermem,bufsize);
  600.   if not assigned(buffermem) then
  601.     buffersize:=0
  602.   else buffersize:=bufsize;
  603. end;
  604.  
  605. const
  606.   { Vorgabegröße für Hilfsspeicher }
  607.   bufferstandardsize = 64*8196;      { 0,5 MB }
  608.  
  609. procedure CloseGraph;
  610. begin
  611.   if isgraphmode then begin
  612.     SetVESAMode(startmode);
  613.     DoneVESA;
  614.     isgraphmode:=false;
  615.   end;
  616. end;
  617.  
  618. procedure InitGraph(var GraphDriver:Integer;var GraphMode:Integer;const PathToDriver:String);
  619. var index:Integer;
  620. begin
  621.     { Pfad zu den Fonts }
  622.     bgipath:=PathToDriver;
  623.     if bgipath[length(bgipath)]<>'\' then
  624.     bgipath:=bgipath+'\';
  625.   if Graphdriver=detect then GraphMode:=GetMaxMode;
  626.     { Standartfonts installieren }
  627.     InstallUserFont('TRIP');
  628.     InstallUserFont('LITT');
  629.     InstallUserFont('SANS');
  630.     InstallUserFont('GOTH');
  631.     InstallUserFont('SCRI');
  632.     InstallUserFont('SIMP');
  633.     InstallUserFont('TSCR');
  634.     InstallUserFont('LCOM');
  635.     InstallUserFont('EURO');
  636.     InstallUserFont('BOLD');
  637.  
  638.   GetVESAInfo(GraphMode);
  639. {$IFDEF DEBUG}
  640.    {$I VESADEB.PPI}
  641. {$ENDIF}
  642.   isgraphmode:=SetVESAMode(GraphMode);
  643.   if isgraphmode then begin
  644.     for index:=0 to VESAInfo.XResolution do X_Array[index]:=index * BytesPerPixel;
  645.     for index:=0 to VESAInfo.YResolution do Y_Array[index]:=index * BytesPerLine;
  646.     SetGraphBufSize(bufferstandardsize);
  647.     graphdefaults;
  648.   end else Oh_Kacke('unable to init graphmode $'+HexStr(GraphMode,4));
  649. end;
  650.  
  651. function RegisterBGIdriver(driver : pointer) : integer;
  652. begin 
  653. end;
  654.  
  655. function InstallUserDriver(const DriverFileName : string;AutoDetectPtr : pointer) : integer;
  656. begin 
  657. end;
  658.  
  659. function GetMaxMode:Integer;
  660. var i:Byte;
  661. begin
  662.   for i:=VESANumber downto 0 do 
  663.     if GetVesaInfo(VESAModes[i]) then 
  664.     begin 
  665.        GetMaxMode:=VESAModes[i];
  666.        Exit;
  667.     end;
  668. end;
  669.  
  670. function GetMaxX:Integer;
  671. begin 
  672.   if not isgraphmode then
  673.     begin
  674.       _graphresult:=grNoInitGraph;
  675.       Exit;
  676.     end;
  677.     GetMaxX:=VESAInfo.XResolution-1;
  678. end;
  679.  
  680. function GetMaxY:Integer;
  681. begin
  682.   if not isgraphmode then
  683.     begin
  684.       _graphresult:=grNoInitGraph;
  685.       Exit;
  686.     end;
  687.     GetMaxY:=VESAInfo.YResolution-1;
  688. end;
  689.  
  690. function GetX : integer;
  691. begin
  692.   _graphresult:=grOk;
  693.   if not isgraphmode then
  694.    begin
  695.      _graphresult:=grNoInitGraph;
  696.      Exit;
  697.    end;
  698.    GetX:=curx;
  699. end;
  700.  
  701. function GetY : integer;
  702. begin
  703.   _graphresult:=grOk;
  704.   if not isgraphmode then
  705.    begin
  706.      _graphresult:=grNoInitGraph;
  707.      Exit;
  708.    end;
  709. GetY:=cury;
  710. end;
  711.  
  712. procedure SetViewPort(x1,y1,x2,y2 : integer;clip : boolean);
  713.  
  714. begin
  715.   _graphresult:=grOk;
  716.   if not isgraphmode then
  717.     begin
  718.       _graphresult:=grNoInitGraph;
  719.       exit;                                          
  720.     end;
  721.   { Daten überprüfen }
  722.   if (x1<0) or (y1<0) or (x2>=_maxx) or (y2>=_maxy) then exit;
  723.   aktviewport.x1:=x1;
  724.   aktviewport.y1:=y1;
  725.   aktviewport.x2:=x2;
  726.   aktviewport.y2:=y2;
  727.   aktviewport.clip:=clip;
  728. end;
  729.       
  730. procedure GetViewSettings(var viewport : ViewPortType);
  731.  
  732. begin
  733.   _graphresult:=grOk;
  734.   if not isgraphmode then
  735.     begin
  736.     _graphresult:=grNoInitGraph;
  737.     exit;
  738.   end;
  739.   viewport:=aktviewport;
  740. end;
  741.  
  742. { mehrere Bildschirmseiten werden nicht unterstützt }
  743. { Dummy aus Kompatibilitätsgründen                  }
  744. procedure SetVisualPage(page : word);
  745.  
  746. begin
  747.   _graphresult:=grOk;
  748.   if not isgraphmode then
  749.     begin
  750.       _graphresult:=grNoInitGraph;;
  751.       exit;
  752.     end;
  753. end;
  754.  
  755. { mehrere Bildschirmseiten werden nicht unterstützt }
  756. { Dummy aus Kompatibilitätsgründen                  }
  757. procedure SetActivePage(page : word);
  758.  
  759.   begin
  760.      _graphresult:=grOk;
  761.      if not isgraphmode then
  762.        begin
  763.          _graphresult:=grNoInitGraph;;
  764.           exit;
  765.        end;
  766.   end;
  767.     
  768. procedure SetWriteMode(WriteMode : integer);
  769. begin
  770.   _graphresult:=grOk;
  771.   if not isgraphmode then
  772.     begin
  773.       _graphresult:=grNoInitGraph;;
  774.       exit;
  775.     end;
  776.   if (writemode<>xorput) and (writemode<>normalput) then
  777.    begin
  778.       _graphresult:=grError;
  779.       exit;
  780.    end; 
  781.   aktwritemode:=writemode;
  782. end;
  783.  
  784. function GraphResult:Integer;
  785. begin
  786.   GraphResult:=_graphresult;
  787. end;
  788.  
  789. procedure RestoreCRTMode;
  790. begin
  791.   if not isgraphmode then
  792.     begin
  793.       _graphresult:=grNoInitGraph;
  794.       Exit;
  795.     end;
  796.   SetVESAMode(startmode);
  797.   isgraphmode:=false;
  798. end;
  799.  
  800. begin
  801.   InitVESA;
  802.   if not DetectVESA then Oh_Kacke('VESA-BIOS not found...'); 
  803.   startmode:=GetVESAMode;
  804.   bankswitchptr:=@switchbank;
  805.   GraphGetMemPtr:=@system.getmem;
  806.   GraphFreeMemPtr:=@system.freemem;
  807.   Getdefaultfont;
  808.   if not isDPMI then begin
  809.    wrbuffer:=pointer($D0000000);
  810.    rbuffer:=pointer($D0200000);
  811.    wbuffer:=pointer($D0200000);
  812.   end else begin 
  813.    wrbuffer:=pointer($0);
  814.    rbuffer:=pointer($0);
  815.    wbuffer:=pointer($0);
  816.   end;
  817. end.
  818.